(******************************************************************************)
(**)                        ОТДЕЛ ПроQR+;
(******************************************************************************
 * НАЗНАЧЕНИЕ: 
 *   решение систем линейных уравнений (A*x=b) методом QR-разложения
 *
 * ПРИМЕЧАНИЯ: 
 *     Система уравнений записана в файле "ПроМатр2.дан".
 *     В этом файле 1-я строка содержит размер матрицы A
 *   (число строк и столбцов), в следующих строках записанны значения элементов
 *   матрицы A, потом на отдельной строке размер матрицы свободных членов B
 *   (число векторов b и их размер), а далее значения элементов матрицы B, 
 *   в которой строки являются векторами b.
 *
 *     Прямоугольная матрица A (N на M, с N >= M) раскладывается на два
 *   сомножителя (A=Q*R), где Q (N на M) ортогональная матрица, а
 *   R (M на M) - верхняя треугольная матрица. Получаем Q*R*x = b, далее
 *   R*x = Q'b. Последняя система решается методом обратной подстановки.
 *     Если система несовместна (N > M), то метод возвращает такой вектор x,
 *   для которого A*x является наилучшим приближением к b (по норме). 
 ******************************************************************************)
ИСПОЛЬЗУЕТ
  Матр   ИЗ "...\Отделы\Числа\",
  МатрВВ ИЗ "...\Отделы\Числа\",
  Читать ИЗ "...\Отделы\Обмен\",
  Вывод  ИЗ "...\Отделы\Обмен\";

(******************************************************************************)
ЗАДАЧА Голова;
ПОСТ
  TOL=1.D-8;   (* собственные значения обнуляются, если они более чем
                  * в TOL раз меньше наибольшего собственного значения  *)
ПЕР
  n:ЦЕЛ;  (* размер вектора свободных членов *)
  nv:ЦЕЛ; (* число векторов свободных членов *)
  A:Матр.Доступ; (* матрица системы *)
  R:Матр.Доступ; (* верхняя треугольная матрица *)
  B:Матр.Доступ; (* вектора свободных членов *)
  X:Матр.Доступ; (* вектора решения *)
  i:ЦЕЛ; 
  п:Читать.Поток;
УКАЗ
  п:=МатрВВ.ОткрытьПоток("ПроМатр2.дан");
  A:=МатрВВ.ЧитатьМатр(п);
  B:=МатрВВ.ЧитатьМатр(п);
  Читать.Закрыть(п);
  nv:=РАЗМЕР(B^,0);
  n:=РАЗМЕР(B^,1);
  СОЗДАТЬ(R,n,n);
  СОЗДАТЬ(X,nv,n);
  Вывод.Цепь("^Исходная матрица:^");
  МатрВВ.ВыводМатр("%10.5f",A^);
  Вывод.Цепь("^Вектора свободных членов:^");
  ОТ i:=0 ДО nv-1 ВЫП
    МатрВВ.ВыводВект("%10.5f",B[i])
  КОН;
  (* После выполнения РазложитьНаQR матрица Q оказывается на месте матрицы A *)
  ЕСЛИ Матр.РазложитьНаQR(A^,R^) = 0 ТО
    (* решаем систему для каждого вектора свободных членов b *)
    Вывод.Цепь("^Вектора решения:^");
    ОТ i:=0 ДО nv-1 ВЫП
      Матр.РешитьИзQR(A^,R^,B[i],X[i]); 
      МатрВВ.ВыводВект("%10.5f",X[i])
    КОН
  ИНАЧЕ
    Вывод.Цепь("^Вырожденная матрица!^")
  КОН
КОН Голова;

(******************************************************************************)
УКАЗ
  Голова
КОН ПроQR.

▲ Вопросы, замечания и предложения высылайте на atimopheyev@yahoo.com или Издателю Глагола: